home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d963.lha / SIOD / scm / inspect.scm < prev    next >
Text File  |  1993-06-29  |  4KB  |  63 lines
  1. (define (inspect . openv)
  2.         (display "SIOD Debugger" standard-output)
  3.         (display (integer->char 10) standard-output)
  4.         (if openv (set! *cenv* openv))
  5.         (set! *cenv* (cons *cenv* '()))
  6.         (do () ((null? *cenv*))
  7.                (display (integer->char 10) standard-output)
  8.                (display "Command (h for help) : " standard-output)
  9.                (case (read standard-input)
  10.                      ((e errobj) (print errobj standard-output))
  11.                      ((x expression)  (print *cargs* standard-output))
  12.                      ((p parent) 
  13.                       (if (car *cenv*)
  14.                           (begin (set-cdr! *cenv* (cons (car *cenv*) (cdr *cenv*)))
  15.                                  (set-car! *cenv* (environment-parent (car *cenv*))))
  16.                           (display "There is no parent environment"
  17.                                    standard-output)))
  18.                      ((s son) 
  19.                       (if (cdr *cenv*)
  20.                           (begin (set-car! *cenv*  (car (cdr *cenv*)))
  21.                                  (set-cdr! *cenv* (cdr (cdr *cenv*))))
  22.                           (display "There is no son environment"
  23.                                    standard-output)))
  24.                      ((b bindings) 
  25.                       (if (car *cenv*)
  26.                           (print (environment-bindings (car *cenv*))
  27.                                   standard-output)
  28.                           (display "Current environment is the global environment"
  29.                                    standard-output)))
  30.                      ((m message) (display *lasterr* standard-output))
  31.                      ((v eval) 
  32.                       (display "eval >> " standard-output)
  33.                       (print (eval (read standard-input) (car *cenv*))
  34.                              standard-output))
  35.                      ((g go) 
  36.                       (set! errobj '())
  37.                       (set! *cenv* '())
  38.                       (set! *cargs* '()))
  39.                      ((q quit) 
  40.                       (set! errobj '())
  41.                       (set! *cenv* '())
  42.                       (set! *cargs* '())
  43.                       (reset))
  44.                      ((h help) 
  45.                       (display "e / errobj -- shows errobj" standard-output)
  46.                       (display (integer->char 10) standard-output)
  47.                       (display "b / bindings -- shows current environment bindings" standard-output)
  48.                       (display (integer->char 10) standard-output)
  49.                       (display "x / expression -- shows current expression" standard-output)
  50.                       (display (integer->char 10) standard-output)
  51.                       (display "p / parent -- move up to parent environment" standard-output)
  52.                       (display (integer->char 10) standard-output)
  53.                       (display "s / son -- move down to son environment" standard-output)
  54.                       (display (integer->char 10) standard-output)
  55.                       (display "q / quit -- quits SIOD Debugger" standard-output)
  56.                       (display (integer->char 10) standard-output)
  57.                       (display "g / go -- resumes execution in a breakpoint" standard-output)
  58.                       (display (integer->char 10) standard-output)
  59.                       (display "m / message -- shows the last error message" standard-output)
  60.                       (display (integer->char 10) standard-output))
  61.                      (else (display "Unknown command" standard-output)
  62.                            (display (integer->char 10) standard-output)))))
  63.